home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / UTILITY1 / MSWSRC35.ZIP / COMS.CPP < prev    next >
C/C++ Source or Header  |  1993-09-21  |  9KB  |  431 lines
  1. /*
  2.  *      coms.c      program execution control module    dvb
  3.  *
  4.  *    Copyright (C) 1989 The Regents of the University of California
  5.  *    This Software may be copied and distributed for educational,
  6.  *    research, and not for profit purposes provided that this
  7.  *    copyright and statement are included in all such copies.
  8.  *
  9.  */
  10.  
  11. #include "logo.h"
  12. #include "globals.h"
  13. #ifdef ibm
  14. #include "process.h"
  15. #include <time.h>
  16. #endif
  17. #ifdef mac
  18. #include <console.h>
  19. #endif
  20.  
  21. FIXNUM ift_iff_flag = -1;
  22.  
  23. NODE *make_cont(enum labels cont, NODE *val) {
  24. #ifdef __ZTC__
  25.     union { enum labels lll;
  26.            NODE *ppp;} cast;
  27. #endif
  28.     NODE *retval = cons(NIL, val);
  29. #ifdef __ZTC__
  30.     cast.lll = cont;
  31.     retval->n_car = cast.ppp;
  32. #else
  33.     retval->n_car = (NODE *)cont;
  34. #endif
  35.     settype(retval, CONT);
  36.     return retval;
  37. }
  38.  
  39. NODE *loutput(NODE *arg)
  40. {
  41.     if (NOT_THROWING) {
  42.     stopping_flag = OUTPUT;
  43.     output_node = reref(output_node, car(arg));
  44.     }
  45.     return(UNBOUND);
  46. }
  47.  
  48. NODE *lstop()
  49. {
  50.     if (NOT_THROWING)
  51.     stopping_flag = STOP;
  52.     return(UNBOUND);
  53. }
  54.  
  55. NODE *lthrow(NODE *arg)
  56. {
  57.     if (NOT_THROWING) {
  58.     if (compare_node(car(arg),Error,TRUE) == 0) {
  59.         if (cdr(arg) != NIL)
  60.         err_logo(USER_ERR, cadr(arg));
  61.         else
  62.         err_logo(USER_ERR, UNBOUND);
  63.     } else {
  64.         stopping_flag = THROWING;
  65.         throw_node = reref(throw_node, car(arg));
  66.         if (cdr(arg) != NIL)
  67.         output_node = reref(output_node, cadr(arg));
  68.         else
  69.         output_node = reref(output_node, UNBOUND);
  70.     }
  71.     }
  72.     return(UNBOUND);
  73. }
  74.  
  75. NODE *lcatch(NODE *args)
  76. {
  77.     return make_cont(catch_continuation, cons(car(args), lrun(cdr(args))));
  78. }
  79.  
  80. int torf_arg(NODE *args)
  81. {
  82.     NODE *arg = car(args);
  83.  
  84.     while (NOT_THROWING) {
  85.     if (compare_node(arg, Truex, TRUE) == 0) return TRUE;
  86.     if (compare_node(arg, Falsex, TRUE) == 0) return FALSE;
  87.     setcar(args, err_logo(BAD_DATA, arg));
  88.     arg = car(args);
  89.     }
  90.     return -1;
  91. }
  92.  
  93. NODE *lnot(NODE *args)
  94. {
  95.     int arg = torf_arg(args);
  96.  
  97.     if (NOT_THROWING) {
  98.     if (arg) return(Falsex);
  99.     else return(Truex);
  100.     }
  101.     return(UNBOUND);
  102. }
  103.  
  104. NODE *land(NODE *args)
  105. {
  106.     int arg;
  107.  
  108.     if (args == NIL) return(Truex);
  109.     while (NOT_THROWING) {
  110.     arg = torf_arg(args);
  111.     if (arg == FALSE)
  112.         return(Falsex);
  113.     args = cdr(args);
  114.     if (args == NIL) break;
  115.     }
  116.     if (NOT_THROWING) return(Truex);
  117.     else return(UNBOUND);
  118. }
  119.  
  120. NODE *lor(NODE *args)
  121. {
  122.     int arg;
  123.  
  124.     if (args == NIL) return(Falsex);
  125.     while (NOT_THROWING) {
  126.     arg = torf_arg(args);
  127.     if (arg == TRUE)
  128.         return(Truex);
  129.     args = cdr(args);
  130.     if (args == NIL) break;
  131.     }
  132.     if (NOT_THROWING) return(Falsex);
  133.     else return(UNBOUND);
  134. }
  135.  
  136. NODE *runnable_arg(NODE *args) {
  137.     NODE *arg = car(args);
  138.  
  139.     if (!aggregate(arg)) {
  140.     setcar(args, parser(arg, TRUE));
  141.     arg = car(args);
  142.     }
  143.     while (!is_list(arg) && NOT_THROWING) {
  144.     setcar(args, err_logo(BAD_DATA, arg));
  145.     arg = car(args);
  146.     }
  147.     return(arg);
  148. }
  149.  
  150. NODE *lif(NODE *args)    /* macroized */
  151. {
  152.     NODE *yes;
  153.     int pred;
  154.  
  155.     if (cddr(args) != NIL) return(lifelse(args));
  156.  
  157.     pred = torf_arg(args);
  158.     yes = runnable_arg(cdr(args));
  159.     if (NOT_THROWING) {
  160.     if (pred) return(yes);
  161.     return(NIL);
  162.     }
  163.     return(UNBOUND);
  164. }
  165.  
  166. NODE *lifelse(NODE *args)    /* macroized */
  167. {
  168.     NODE *yes, *no;
  169.     int pred;
  170.  
  171.     pred = torf_arg(args);
  172.     yes = runnable_arg(cdr(args));
  173.     no = runnable_arg(cddr(args));
  174.     if (NOT_THROWING) {
  175.     if (pred) return(yes);
  176.     return(no);
  177.     }
  178.     return(UNBOUND);
  179. }
  180.  
  181. NODE *lrun(NODE *args)    /* macroized */
  182. {
  183.     NODE *arg = runnable_arg(args);
  184.  
  185.     if (NOT_THROWING) return(arg);
  186.     return(UNBOUND);
  187. }
  188.  
  189. NODE *lrunresult(NODE *args)
  190. {
  191.     return make_cont(runresult_continuation, lrun(args));
  192. }
  193.  
  194. NODE *pos_int_arg(NODE *args)
  195. {
  196.     NODE *arg = car(args), *val;
  197.  
  198.     val = cnv_node_to_numnode(arg);
  199.     while ((nodetype(val) != INT || getint(val) < 0) && NOT_THROWING) {
  200.     gcref(val);
  201.     setcar(args, err_logo(BAD_DATA, arg));
  202.     arg = car(args);
  203.     val = cnv_node_to_numnode(arg);
  204.     }
  205.     setcar(args,val);
  206.     if (nodetype(val) == INT) return(val);
  207.     return UNBOUND;
  208. }
  209.  
  210. NODE *lrepeat(NODE *args)
  211. {
  212.     NODE *cnt, *torpt, *retval = NIL;
  213.  
  214.     global_repcount_index++;
  215.     global_repcount[global_repcount_index] = 1;
  216.     cnt = pos_int_arg(args);
  217.     torpt = lrun(cdr(args));
  218.     if (NOT_THROWING) {
  219.     retval = make_cont(repeat_continuation, cons(cnt,torpt));
  220.     }
  221.     return(retval);
  222. }
  223.  
  224. NODE *lrepcount()
  225. {
  226.     return(make_intnode((FIXNUM)global_repcount[global_repcount_index]));
  227. }
  228.  
  229. NODE *lforever(NODE *args)
  230. {
  231.     NODE *torpt = lrun(args);
  232.  
  233.     if (NOT_THROWING)
  234.     return make_cont(repeat_continuation, cons(make_intnode(-1), torpt));
  235.     return NIL;
  236. }
  237.  
  238. NODE *ltest(NODE *args)
  239. {
  240.     int arg = torf_arg(args);
  241.  
  242.     if (tailcall != 0) return UNBOUND;
  243.     if (NOT_THROWING) {
  244.     ift_iff_flag = arg;
  245.         dont_fix_ift = 1;
  246.     }
  247.     return(UNBOUND);
  248. }
  249.  
  250. NODE *liftrue(NODE *args)
  251. {
  252.     if (ift_iff_flag < 0)
  253.     return(err_logo(NO_TEST,NIL));
  254.     else if (ift_iff_flag > 0)
  255.     return(lrun(args));
  256.     else
  257.     return(NIL);
  258. }
  259.  
  260. NODE *liffalse(NODE *args)
  261. {
  262.     if (ift_iff_flag < 0)
  263.     return(err_logo(NO_TEST,NIL));
  264.     else if (ift_iff_flag == 0)
  265.     return(lrun(args));
  266.     else
  267.     return(NIL);
  268. }
  269.  
  270. void prepare_to_exit(BOOLEAN okay)
  271. {
  272. #ifdef mac
  273.     if (okay) {
  274.     console_options.pause_atexit = 0;
  275.     exit(0);
  276.     }
  277. #endif
  278. #ifdef ibm
  279.     exit_program();
  280.     ltextscreen();
  281.     ibm_plain_mode();
  282. #endif
  283. #ifdef unix
  284.     extern int getpid();
  285.     char ef[30];
  286.  
  287.     charmode_off();
  288.     sprintf(ef, "/tmp/logo%d", getpid());
  289.     unlink(ef);
  290. #endif
  291. }
  292.  
  293. NODE *lbye()
  294. {
  295.     prepare_to_exit(TRUE);
  296. //    if (ufun != NIL || loadstream != stdin) exit(0);
  297. //    if (isatty(0) && isatty(1)) lcleartext();
  298. //    printf("Thank you for using Logo.\n");
  299. //    printf("Have a nice day.\n");
  300.     return(UNBOUND);
  301. }
  302.  
  303. NODE *ltime(void) /*routine*/
  304. /* LOGO time */
  305.    {
  306.    NODE *arg, *val = UNBOUND;
  307.    char *Xtim;
  308.    time_t tvec;
  309.    
  310.    time(&tvec);
  311.    Xtim = ctime(&tvec);
  312.  
  313.    arg = make_strnode(Xtim, NULL, strlen(Xtim)-1, STRING, strnzcpy);
  314.    val = parser(arg, FALSE);
  315.    return(val);
  316.  
  317. //   return(make_strnode(Xtim, NULL, strlen(Xtim), STRING, strnzcpy));
  318. //   return(make_static_strnode(Xtim));
  319.    }
  320.  
  321. NODE *lwait(NODE *args)
  322. {
  323.     NODE *num;
  324.     unsigned int n;
  325. //    long itim;
  326.     clock_t NumTicksToWait;
  327.  
  328.     num = pos_int_arg(args);
  329.     if (NOT_THROWING) {
  330. //    fflush(stdout); /* csls v. 1 p. 7 */
  331. #ifdef __ZTC__
  332.     zflush();
  333. #endif
  334.     if (getint(num) > 0) {
  335. #ifdef bsd
  336. #ifdef ultrix
  337.         n = (unsigned int)getint(num) / 60;
  338.         sleep(n);
  339. #else
  340.         n = (unsigned int)getint(num) * 16667;
  341.         usleep(n);
  342. #endif
  343. #else
  344.    NumTicksToWait = (((unsigned int)getint(num)*CLK_TCK) / 60) + clock();
  345.    while (NumTicksToWait > clock()) MyMessageScan();
  346. #endif
  347.     }
  348.     }
  349.     return(UNBOUND);
  350. }
  351.  
  352. NODE *lshell(NODE *args)
  353. {
  354. #ifdef mac
  355.     printf("Sorry, no shell on the Mac.\n");
  356.     return(UNBOUND);
  357. #else
  358. #ifdef ibm
  359.     NODE *arg;
  360.     char in[5][40] = { "\0", "\0", "\0", "\0", "\0" };
  361.     int count = 0;
  362.  
  363.     arg = car(args);
  364.     while (!is_list(arg) && NOT_THROWING) {
  365.     setcar(args, err_logo(BAD_DATA, arg));
  366.     arg = car(args);
  367.     }
  368.     if (arg == NIL) {
  369.     ndprintf(stdout,"Type EXIT to return to Logo.\n");
  370.     if (1
  371. //spawnlp(P_WAIT, "command", "command", NULL)
  372. )
  373.         err_logo(FILE_ERROR,
  374.           make_static_strnode
  375.          ("Could not open shell (probably due to low memory)"));
  376.     }
  377.     else {
  378.     print_stringlen = 39;
  379.     while (arg != NIL && count < 5) {
  380.         print_stringptr = in[count++];
  381.         ndprintf((FILE *)NULL,"%s",car(arg));
  382.         *print_stringptr = '\0';
  383.         arg = cdr(arg);
  384.     }
  385.     if (1
  386. //spawnlp(P_WAIT, in[0], in[0], in[1], in[2], in[3], in[4], NULL)
  387. )
  388.         err_logo(FILE_ERROR,
  389.           make_static_strnode
  390.          ("Could not open shell (probably due to low memory)"));
  391.     }
  392.     return(UNBOUND);
  393. #else
  394.     extern FILE *popen();
  395.     char cmdbuf[MAX_BUFFER_SIZE];
  396.     FILE *strm;
  397.     NODE *head = NIL, *t